'--------------------------------------------------------------------------------
' This is CreateShortcut.inc v0.2 for PBWin9. Usage:
'    CreateShortcut _
'      targetfile,   _                       ' 1. the link file to be created
'      EXE.FULL$,                          _ ' 2. the file/document where the shortcut should point to
'      (dw_script),                        _ ' 3. command-line parameters
'      EXE.PATH$,                          _ ' 4. the folder where the executable file should start in
'      %SW_SHOW,                           _ ' 5. %SW_SHOW, %SW_HIDE etc.
'      EXE.FULL$,                          _ ' 6. icon file or executable file containing an icon
'      0,                                  _ ' 7. icon index in the aforementioned file
'      ("(c) "+dw_author+" - v."+dw_ver)     ' 8. any comment (stored in the shortcut)
'--------------------------------------------------------------------------------
#INCLUDE ONCE "Win32Api.inc"
#INCLUDE ONCE "ObjBase.inc"
' Prototypes
DECLARE FUNCTION IShellLink_Call0(BYVAL pUnk AS LONG) AS LONG
DECLARE FUNCTION IShellLink_Call1(BYVAL pUnk AS LONG, BYVAL p1 AS LONG) AS LONG
DECLARE FUNCTION IShellLink_Call2(BYVAL pUnk AS LONG, BYVAL p1 AS LONG, BYVAL p2 AS LONG) AS LONG
'--------------------------------------------------------------------------------
FUNCTION CreateShortcut( _
      BYVAL sTargetLinkName AS STRING _
    , BYVAL sSourceFileName AS STRING _
    , BYVAL sArguments      AS STRING _
    , BYVAL sWorkDir        AS STRING _
    , BYVAL nShowCmd        AS LONG _
    , BYVAL sIconFile       AS STRING _
    , BYVAL nIconIndex      AS LONG _
    , BYVAL sComment        AS STRING _
    ) AS LONG

    LOCAL CLSID_ShellLink AS STRING * 16
    LOCAL IID_IShellLink  AS STRING * 16
    LOCAL IID_Persist     AS STRING * 16
    LOCAL nResult         AS LONG
    LOCAL pShellLnk       AS DWORD PTR
    LOCAL pPersist        AS DWORD PTR

    ' IShellLink interface
    ' IID = 000214EE-0000-0000-C000-000000000046
    ' Inherited interface = IUnknown

    CLSID_ShellLink = MKL$(&H00021401) & CHR$(0, 0, 0, 0, &HC0, 0, 0, 0, 0, 0, 0, &H46)
    IID_IShellLink  = MKL$(&H000214EE) & CHR$(0, 0, 0, 0, &HC0, 0, 0, 0, 0, 0, 0, &H46)
    IID_Persist     = MKL$(&H0000010B) & CHR$(0, 0, 0, 0, &HC0, 0, 0, 0, 0, 0, 0, &H46)
    sTargetLinkName = UCODE$(sTargetLinkName)

    CALL CoInitialize(BYVAL 0&)

    IF CoCreateInstance(BYVAL VARPTR(CLSID_ShellLink), BYVAL NOTHING, 1, BYVAL VARPTR(IID_IShellLink), pShellLnk) = 0 THEN
        ' IShellLink::SetPath
        CALL DWORD @@pShellLnk[20] USING IShellLink_Call1(pShellLnk, STRPTR(sSourceFileName))
        ' IShellLink::SetsArguments
        CALL DWORD @@pShellLnk[11] USING IShellLink_Call1(pShellLnk, STRPTR(sArguments))
        ' IShellLink::SetWorkingDirectory
        CALL DWORD @@pShellLnk[9] USING IShellLink_Call1(pShellLnk, STRPTR(sWorkDir))
        ' IShellLink::SetnShowCmd
        CALL DWORD @@pShellLnk[15] USING IShellLink_Call1(pShellLnk, nShowCmd)
        ' IShellLink::SetDescription
        CALL DWORD @@pShellLnk[7] USING IShellLink_Call1(pShellLnk, STRPTR(sComment))
        ' Obtain persist interface (QueryInterface)
        CALL DWORD @@pShellLnk[0] USING IShellLink_Call2(pShellLnk, VARPTR(IID_Persist), VARPTR(pPersist))
         ' IShellLink::SetIconLocation
        CALL DWORD @@pShellLnk[17] USING IShellLink_Call2(pShellLnk, STRPTR(sIconFile), 0)

        IF nResult = 0 THEN
            ' Convert to unicode
            ' IPersistFile::Save
            CALL DWORD @@pPersist[6] USING IShellLink_Call2(pPersist, STRPTR(sTargetLinkName), 1)
            ' Release
            CALL DWORD @@pPersist[2] USING IShellLink_Call0(pPersist)
        END IF

        ' Release
        CALL DWORD @@pShellLnk[2] USING IShellLink_Call0(pShellLnk)
        FUNCTION = -1

    END IF

    CALL CoUninitialize()
END FUNCTION
'--------------------------------------------------------------------------------